home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / cshift / test3.f < prev    next >
Text File  |  1993-03-23  |  2KB  |  102 lines
  1.       program shift_test
  2.  
  3.       parameter (n=20)
  4.  
  5.       real a(n,n,n), b(n,n,n)
  6.  
  7.       call cmf_random (b)
  8.  
  9.       call test (a,b,n, 1, 1)
  10.       call test (a,b,n, 1, -1)
  11.       call test (a,b,n, 1, 49)
  12.       call test (a,b,n, 1, 51)
  13.       call test (a,b,n, 1, -51)
  14.       call test (a,b,n, 1, 13)
  15.  
  16.       call test1 (a,b,n, 1, 1)
  17.       call test1 (a,b,n, 1, -1)
  18.       call test1 (a,b,n, 1, 49)
  19.       call test1 (a,b,n, 1, 51)
  20.       call test1 (a,b,n, 1, -51)
  21.       call test1 (a,b,n, 1, 13)
  22.  
  23.       call test (a,b,n, 2, 1)
  24.       call test (a,b,n, 2, -1)
  25.       call test (a,b,n, 2, 49)
  26.       call test (a,b,n, 2, 51)
  27.       call test (a,b,n, 2, -51)
  28.       call test (a,b,n, 2, 13)
  29.  
  30.       call test1 (a,b,n, 2, 1)
  31.       call test1 (a,b,n, 2, -1)
  32.       call test1 (a,b,n, 2, 49)
  33.       call test1 (a,b,n, 2, 51)
  34.       call test1 (a,b,n, 2, -51)
  35.       call test1 (a,b,n, 2, 13)
  36.  
  37.       call test (a,b,n, 3, 1)
  38.       call test (a,b,n, 3, -1)
  39.       call test (a,b,n, 3, 49)
  40.       call test (a,b,n, 3, 51)
  41.       call test (a,b,n, 3, -51)
  42.       call test (a,b,n, 3, 13)
  43.  
  44.       call test1 (a,b,n, 3, 1)
  45.       call test1 (a,b,n, 3, -1)
  46.       call test1 (a,b,n, 3, 49)
  47.       call test1 (a,b,n, 3, 51)
  48.       call test1 (a,b,n, 3, -51)
  49.       call test1 (a,b,n, 3, 13)
  50.  
  51.       end
  52.  
  53.       subroutine test (a, b, n, dim, pos)
  54.       integer n, dim
  55.       real a(n,n,n), b(n,n,n)
  56.       logical equal (n,n,n)
  57.       integer pos
  58.       integer errors
  59.  
  60.       a = b
  61.  
  62.       b = cshift (b, dim, pos)
  63.  
  64.       if (pos .gt. 0) then
  65.          do i = 1, pos
  66.             a = cshift (a, dim, 1)
  67.          end do
  68.       end if
  69.  
  70.       if (pos .lt. 0) then
  71.          do i = 1, -pos
  72.             a = cshift (a, dim, -1)
  73.          end do
  74.       end if
  75.  
  76.       equal = (b .eq. a)
  77.       errors = count (equal)
  78.       errors = n*n*n - errors
  79.  
  80.       print *, errors, ' Errors for one shift in dim', dim,' with pos = ', pos
  81.       end
  82.  
  83.       subroutine test1 (a, b, n, dim, pos)
  84.       integer n, dim
  85.       real a(n,n,n), b(n,n,n)
  86.       logical equal (n,n,n)
  87.       integer pos
  88.       integer errors
  89.  
  90.       a = b
  91.       do i = 1, n
  92.          a = cshift (a, dim, pos)
  93.       end do
  94.  
  95.       equal = (b .eq. a)
  96.       errors = count (equal)
  97.       errors = n*n*n - errors
  98.  
  99.       print *, errors, ' Errors for many shift in dim', dim,' with pos = ', pos
  100.       end
  101.  
  102.